{
Traviesadora beta 0.2.0.13.33 (30.11.2008)
LastMod: 30.11.2008 by Prof1983

Copyright 2008, travieorama@googlemail.com

This file is part of the taviesadora project

taviesadora is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

taviesadora is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.
}
unit TerminalFunctions;

interface

uses
  Windows, Classes, Messages, SysUtils,
  {AdProtcl, AdPort, OoMisc, AdSelCom, AdExcept,}
  Dialogs, Forms, StdCtrls, StrUtils, ComCtrls;

type // Prof1983
  TParity = Integer;
  TApdComPort = Integer;
  TApdProtocol = Integer;
  TApdProtocolLog = Integer;

type
  TTermErrorCode = (rsBusy,rsNoErrorYet,rsTimeOut,rsFailed,rsCOMError,rsCanceled,rsFileNotFound,rsCantOpenFile,rsBoardError,rsLinuxError);
  TTermError = record
    Error:TTermErrorCode;
    ExtText: string;
  end;

TTerminalFunctions = class
  public
    constructor Create(ComPort:integer;Baud,StopBits,DataBits:integer;Parity:TParity);
    constructor CreateSimple(ComPort:integer;Baud:integer);
    constructor CreateNaked;
    destructor destroy;
    procedure SetPortParams(ComPort:integer;Baud,StopBits,DataBits:integer;Parity:TParity);
    function GetCOMPortNumber:integer;
    procedure SetAppName(Text:string);
    function  OpenComPort:boolean;
    procedure CloseComPort;
    procedure Cancel;
    procedure Reset;
    procedure SetProgressBar(pb:TProgressBar);
    procedure SetTermWindow(List:TMemo);
    function GetLastError:TTermError;
    procedure SetTimout(TimeOut:integer);
    procedure SetLogFileName(LogFile:string);
    procedure SetBoardError;
    procedure SetLinuxError;
    procedure TermFuncWait(WaitFor:String);
    procedure TermFuncUpload(Protocol,FileName:string);
    procedure TermFuncSend(Text:string);
    procedure TermFuncMsgBox(Text:string;mode:integer);
    function  TermFuncAskBox(Text:string):string;
    function  TermFuncWaitMux(WaitForMux:string):integer;
    procedure TermFuncDelay(ms:integer);
    procedure TermFuncSendRaw(Data:Byte);
    procedure TermWindowCls;
    procedure TermWindowSay(text:string);
    function open: boolean;
    procedure RegisterDataCallBack(cb:TObject);
    procedure UnRegisterDataCallBack;
  private
    TermError:TTermError;
    DataCallback:TObject;
    AppName:string;
    ComInitialized:boolean;
    TimeOut:integer;
    pb:TProgressbar;
    WaitMuxResult:integer;
    LogPath:string;
    IsXModemTransmitting:boolean;
    WaitResult:integer;
    TerminalMemo:TMemo;
    COMInputBufferWhileExec:string;
    WaitForList:TStringList;
    ApdComPort: TApdComPort;
    ApdProtocol: TApdProtocol;
    ApdProtocolLog: TApdProtocolLog;
    Logger:TStringList;
    procedure GenerateWaitForList(Text:string);
    function TestWaitForString(var Text:string):integer;
    function GetMaxLengthInWaitForList:integer;
    procedure ApdProtocollProtocolFinish(CP: TObject; ErrorCode: Integer);
    procedure ApdProtocollProtocolStatus(CP: TObject; Options: Word);
    function MSecs2Ticks(ms:longint):longint;
    procedure ApdComPortTriggerAvail(CP: TObject; Count: Word);
    procedure TransferBinary(FileName:string);
    procedure TransferBuffer(buffer: array of Byte;Size:integer);
    procedure ApdProtocol1ProtocolFinish(CP: TObject; ErrorCode: Integer);

end;

implementation
uses VibDriver;


{ TTerminalFunctions }

procedure TTerminalFunctions.Reset;
begin
  //cancelled := false;
  TermError.Error := rsNoErrorYet;
//  InProgress := false;
  COMInputBufferWhileExec := '';
  TermError.ExtText := '';
end;

procedure TTerminalFunctions.Cancel;
begin
  TermError.Error := rsCanceled;
end;

procedure TTerminalFunctions.CloseComPort;
begin
  TermError.Error := rsCanceled;
  ApdComPort.Open := false;
end;

constructor TTerminalFunctions.create(ComPort:integer;Baud,StopBits,DataBits:integer;Parity:TParity);
begin
 CreateNaked;
 SetPortParams(ComPort,Baud,StopBits,DataBits,Parity);
end;

constructor TTerminalFunctions.CreateSimple(ComPort: integer;Baud:integer);
begin
 CreateNaked;
 SetPortParams(ComPort,Baud,ApdComPort.StopBits,ApdComPort.DataBits,ApdComPort.Parity);
end;

constructor TTerminalFunctions.CreateNaked;
begin
 inherited Create;
 LogPath:='';
 WaitForList := TStringList.Create;
 Logger := TStringList.create;
 pb := nil;
 UnRegisterDataCallBack;
 COMInputBufferWhileExec := '';
 ApdComPort := TApdComPort.Create(nil);
 ApdProtocol := TApdProtocol.Create(nil);
 ApdProtocol.OnProtocolFinish := ApdProtocol1ProtocolFinish;
 ApdProtocol.OnProtocolStatus := ApdProtocollProtocolStatus;
 ApdProtocolLog := TApdProtocolLog.Create(nil);
 ApdComPort.AutoOpen := false;
 ApdComPort.OnTriggerAvail := ApdComPortTriggerAvail;
 ApdProtocol.ComPort := ApdComPort;
// ApdProtocol.
 ApdProtocolLog.Protocol := ApdProtocol; 
 ApdProtocol.ProtocolLog := ApdProtocolLog;
 ApdComPort.Tracing := tlOff;
 ApdComPort.Logging := tlOff;
 ComInitialized := false;
 Reset;
 WaitMuxResult := -1;
 TerminalMemo := nil;
 TimeOut := 10;
end;

destructor TTerminalFunctions.destroy;
begin
  ApdComPort.Destroy;
  ApdProtocol.Destroy;
  ApdProtocolLog.Destroy;
  WaitForList.Destroy;
  inherited destroy;
end;


function TTerminalFunctions.OpenComPort: boolean;
begin
 result := false;
 if IsPortAvailable(ApdComPort.ComNumber) then
  if ComInitialized then begin
    ApdComPort.Open := false;
    while ApdComPort.Open do begin
      Application.ProcessMessages;
    end;
   // ApdComPort.InitPort;
    try
    ApdComPort.Open := true;
    except on EAPDException do begin end;
    end;
    result := ApdComPort.Open;
  end;
end;

function TTerminalFunctions.open: boolean;
begin
  result := ApdComPort.Open and ComInitialized;
end;

procedure TTerminalFunctions.SetPortParams(ComPort:integer;Baud,StopBits,DataBits:integer;Parity:TParity);
begin
  ApdComPort.ComNumber := ComPort;
  ApdComPort.Baud := Baud;
  ApdComPort.StopBits := StopBits;
  ApdComPort.DataBits := DataBits;
  ApdComPort.Parity := Parity;
  ComInitialized := true;
end;

procedure TTerminalFunctions.SetLogFileName(LogFile: string);
var
  a:TstringList;
  path : string;
  FName,ext:string;
  ProtoLog,ComLog,ComTrc:string;
begin
  LogPath := LogFile;
  FName := ExtractFileName(LogFile);
  path := ExtractFilePath(LogFile);
  ext:= ExtractFileExt(LogFile);
  repeat
    if FName[Length(FName)] = '.' then begin
      delete(FName,length(FName),1);
      break;
    end;
    delete(FName,length(FName),1);
  until FName = '';
  ComLog := path+FName+'_ComLog'+ext;
  ComTrc := path+FName+'_ComTrc'+ext;
  ProtoLog := path+FName+'_ProtLog'+ext;
  if (not fileexists(ProtoLog)) and (ProtoLog<>'') then begin
    a := TStringList.create;       //Create new file
    try
      a.SaveToFile(ProtoLog);
    finally
      a.Free;
    end;
  end;

  if LogFile <> '' then begin
    ApdComPort.LogName := ComLog;
    ApdComPort.TraceName := ComTrc;
    ApdProtocolLog.HistoryName := ProtoLog;
    if ApdComPort.Tracing = tlOn then begin
      ApdComPort.Tracing := tlAppend;
      ApdComPort.Logging := tlAppend;
    end else begin
      ApdComPort.Tracing := tlDump;
      ApdComPort.Logging := tlDump;
    end;
    ApdComPort.Tracing := tlOn;
    ApdComPort.Logging := tlOn;
  end else begin
    if ApdComPort.Tracing = tlOn then begin
      ApdComPort.Tracing := tlAppend;
      ApdComPort.Logging := tlAppend;
    end else begin
      ApdComPort.Tracing := tlDump;
      ApdComPort.Logging := tlDump;
    end;
    ApdComPort.LogName := LogFile;
    ApdComPort.LogName := '';
    ApdComPort.TraceName := '';
    ApdProtocolLog.HistoryName := '';
  end;
end;

procedure TTerminalFunctions.SetTimout(TimeOut: integer);
begin
  self.TimeOut := Timeout;
end;

procedure TTerminalFunctions.TransferBuffer(buffer: array of Byte;Size:integer);
var
  a:integer;
  BlockPointer:integer;
  timer:cardinal;
begin
  for BlockPointer := 0 to Size-1 do begin
    timer := GetTickCount;
    while ApdComPort.OutBuffFree <> ApdComPort.OutSize do begin
      if timer+timeout < GetTickCount then begin
        TermError.Error := rsTimeOut;
        exit;
      end;
      inc(a);
      if a mod 10 = 0 then begin
        application.ProcessMessages;
        if TermError.Error <> rsNoErrorYet then begin
          exit;
        end;
      end;
    end;
    a := buffer[BlockPointer];
    ApdComPort.PutChar(chr(a));
  end;
end;

procedure TTerminalFunctions.TransferBinary(FileName: string);
var
  BinFile:TFileStream;
  buffer: array[0..4095] of Byte;
  BlockFull,BlockPointer:integer;
  FileOK:boolean;
  a:integer;
begin
  if TermError.Error <> rsNoErrorYet then exit;
  if not FileExists(FileName) then begin
    TermError.Error := rsFileNotFound;
    TermError.ExtText := ExtractFileName(FileName);
    exit;
  end;
  FileOK := false;
  try
    try
    BinFile := TFileStream.Create(FileName,fmOpenRead);
    if pb <> nil then begin
      pb.Position := 0;
      pb.Max := BinFile.Size;
      pb.Visible := true;
    end;
    FileOK := true;
    if ApdComPort.Open then begin
      repeat
        BlockFull := BinFile.Read(buffer,high(buffer));
        TransferBuffer(buffer,BlockFull);
        if TermError.Error <> rsNoErrorYet then
          exit;
        if pb <> nil then
          pb.Position := BinFile.Position;
      until BlockFull=0;
    end else begin
      TermError.Error := rsCOMError;
    end;
    except on EFopenError do begin
            TermError.Error := rsCantOpenFile;
            TermError.ExtText := ExtractFileName(FileName);
           end;
    end;
  finally
    if pb <> nil then
      pb.Visible := false;
    if FileOK then
      BinFile.Free;
  end;
end;

function TTerminalFunctions.TermFuncAskBox(Text: string): string;
begin
  if TermError.Error = rsNoErrorYet then begin
    Application.MainForm.BringToFront;
    FlashWindow(Application.Handle,true);
    result := InputBox(AppName,Text,'');
  end;
end;

procedure TTerminalFunctions.TermFuncDelay(ms: integer);
begin
  DelayTicks(MSecs2Ticks(ms),true);
end;

procedure TTerminalFunctions.TermFuncMsgBox(Text: string;mode:integer);
begin
  if TermError.Error = rsNoErrorYet then begin
    Application.MainForm.BringToFront;
    FlashWindow(Application.Handle,true);    
    ShowMessage(Text);
  end;
end;

procedure TTerminalFunctions.TermFuncSend(Text: string);
var
  Buffer: array[0..255] of Byte;
  i:integer;
  l:integer;
begin
  if TermError.Error <> rsNoErrorYet then exit;
  COMInputBufferWhileExec := '';

  i := Pos('^M',Text);
  if i > 0 then begin
    delete(text,i,2);
    Insert(#13,text,i);
  end;
  Insert(#00,text,i);
  l := length(Text);
  for i := 0 to l-1 do begin
    Buffer[i] := Byte(Text[i+1]);
  end;
  TransferBuffer(Buffer,l);
end;

procedure TTerminalFunctions.TermFuncSendRaw(Data: Byte);
begin
  if TermError.Error = rsNoErrorYet then begin
    ApdComPort.PutChar(chr(Data));
    //logger.add(chr(Data));
    //logger.SaveToFile('VibOutPut.txt');
  end;
end;

procedure TTerminalFunctions.TermFuncUpload(Protocol, FileName: string);
begin
  if TermError.Error <> rsNoErrorYet then exit;
  if not FileExists(FileName) then begin
    TermError.Error := rsFileNotFound;
    TermError.ExtText := ExtractFileName(FileName);
    exit;
  end;
  if TerminalMemo <> nil then begin
    TerminalMemo.Lines.Add(#9+#9+'***********************'+' TransmittingFile "'+ExtractFileName(FileName)+'" ************************');
    TerminalMemo.Lines.Add('');
  end;
  if uppercase(Protocol)= 'BINARY' then begin
    TransferBinary(FileName);
  end else begin
    ApdProtocol.FileMask := FileName;
    ApdProtocol.ProtocolType := ptXmodem;
    ApdProtocol.StartTransmit;
  end;
end;

procedure TTerminalFunctions.ApdComPortTriggerAvail(CP: TObject;
  Count: Word);

function StrToStrl(S:string):TStringList;
var
  i:integer;
  b:string;
begin
  result := TStringList.Create;
  try
    result.add('');
    b := '';
    for i := 1 to length(s) do begin
      if (s[i] = #10) then
        result.Add('')
      else
        if (s[i] <> #13) then
          result[result.Count-1] := result[result.Count-1]+s[i];
    end;
  except
    result.Free;
    result := nil;
  end;
end;

var
  a:char;
  s:string;
  AppendStr:string;
  SL:TStringList;
  i:integer;
begin
try
  //if ApdProtocol.InProgress then exit;
  if TerminalMemo <> nil then
    TerminalMemo.Lines.BeginUpdate;

  try
    if TerminalMemo <> nil then
      if TerminalMemo.Lines.count > 0 then begin
        AppendStr := TerminalMemo.lines[TerminalMemo.Lines.count-1];
      end else
        AppendStr := '';
    while count>0 do begin
      a := ApdComPort.GetChar;
      if DataCallback <> nil then begin
        if DataCallback is TVibHardwareDriver then
          (DataCallback as TVibHardwareDriver).NewData(a);
      end;
      if a <> #0 then begin
        if a = #08 then
          delete(COMInputBufferWhileExec,length(COMInputBufferWhileExec),1)
        else
          COMInputBufferWhileExec := COMInputBufferWhileExec+a;
        if Waitresult = -1 then begin
          i := TestWaitForString(COMInputBufferWhileExec);
          WaitResult := i;
        end;
      end;
      if TerminalMemo <> nil then begin
        if a = #08 then begin
          delete(AppendStr,length(AppendStr),1);
        end else begin
          AppendStr := AppendStr+a;
        end;
      end;
      dec(count);
    end;
    if TerminalMemo <> nil then begin
      SL := StrToStrl(AppendStr);
      if SL <> nil then begin
        try
          if TerminalMemo.Lines.count > 0 then begin
            TerminalMemo.lines[TerminalMemo.Lines.count-1] := SL[0];
            SL.Delete(0);
            TerminalMemo.lines.AddStrings(SL);
          end else begin
            TerminalMemo.lines.AddStrings(SL);
          end;
        finally
          SL.Free;
        end;
      end;
    end;
  finally
    if TerminalMemo <> nil then
      TerminalMemo.Lines.EndUpdate;
  end;
  if TerminalMemo <> nil then begin
    TerminalMemo.SelStart :=length(TerminalMemo.Lines.text);
    TerminalMemo.SelLength := length(TerminalMemo.Lines.text);
  end;
  except
    on EBufferIsEmpty do begin

    end;
  end;
end;

procedure TTerminalFunctions.TermFuncWait(WaitFor: String);
begin
  TermFuncWaitMux(WaitFor);
end;

function TTerminalFunctions.TermFuncWaitMux(WaitForMux: string): integer;
var
 i:integer;
 timer:Cardinal;
begin
  if TermError.Error <> rsNoErrorYet then exit;
  GenerateWaitForList(WaitForMux);
  result := TestWaitForString(COMInputBufferWhileExec);
  i := 0;
  if result=-1 then begin
    WaitResult := -1;
    timer := GetTickCount;
    while WaitResult = -1 do begin
      if i mod 10 = 0 then begin
        application.ProcessMessages;
        if TermError.Error <> rsNoErrorYet then begin
          exit;
        end;
      end;
      inc(i);
      if timer+timeout < GetTickCount then begin
        TermError.Error := rsTimeOut;
        exit;
      end;
    end;
  end;
  result := Waitresult;
end;

procedure TTerminalFunctions.SetAppName(Text: string);
begin
  AppName := Text;
end;


procedure TTerminalFunctions.SetTermWindow(List: TMemo);
begin
  TerminalMemo := List;
end;

procedure TTerminalFunctions.TermWindowCls;
begin
  if TermError.Error = rsNoErrorYet then
    if TerminalMemo <> nil then
      TerminalMemo.Lines.Clear;
end;

procedure TTerminalFunctions.TermWindowSay(text: string);
begin
  if TermError.Error = rsNoErrorYet then
    if TerminalMemo <> nil then
      TerminalMemo.Lines.add(text);
end;

function TTerminalFunctions.GetLastError: TTermError;
begin
  result := TermError;
end;

procedure TTerminalFunctions.SetBoardError;
begin
  if TermError.Error = rsNoErrorYet then
    TermError.Error := rsBoardError;
end;

procedure TTerminalFunctions.SetLinuxError;
begin
  TermError.Error := rsLinuxError;
end;



procedure TTerminalFunctions.GenerateWaitForList(Text: string);

  function DelSpaceTabs(s:string):string;
  var
    n:integer;
  begin
      n := 1;
      while n < length(s) do begin
        if (s[n] = ' ') or (s[n] = #9) then begin
          delete(s,n,1);
        end else
          inc(n);
      end;
      result := s;
  end;

var
i:integer;
s:string;
begin
  i := 1;
  WaitForList.Clear;
  while i < length(text) do begin
    if Text[i] = '|' then begin
      s := Text;
      delete(s,i, length(s));
      delete(Text,1,i);
      WaitForList.add(s);
      s := DelSpaceTabs(s);
      WaitForList.add(s);
      i := 1;
    end;
    inc(i);
  end;
  WaitForList.Add(Text);
  text := DelSpaceTabs(Text);
  WaitForList.Add(text);
end;

function TTerminalFunctions.GetMaxLengthInWaitForList: integer;
var
  i:integer;
begin
  result := 0;
  for i := 0 to WaitForList.count-1 do begin
    if length(WaitForList[i]) > result then
      result := length(WaitForList[i]);
  end;
  if result = 0 then
    result := 256;
end;

function TTerminalFunctions.TestWaitForString(var Text: string): integer;
var
  i,j:integer;
  s:string;
begin
  result := -1;
  text := trim(text);
  for i := 0 to WaitForList.Count-1 do begin
    s := WaitForList[i];
    if lowercase(s) = 'hit any key' then begin
      s := 'hit any key';
    end;
   { if AnsiEndsStr(,text) then begin
      result := i;
      break;
    end; }
    if pos(s,text)>0 then begin
      result := i div 2;
      delete(text,1,pos(s,text)+length(s));
      WaitForList.Clear;
      break;
    end;
  end;
  if result = -1 then begin
    i := 256;
    if length(text)> i then
      delete(Text,1,length(text)-(i+1));
  end;
end;

procedure TTerminalFunctions.ApdProtocol1ProtocolFinish(CP: TObject;
  ErrorCode: Integer);
begin
  ApdProtocol.FileMask :='';
end;

function TTerminalFunctions.MSecs2Ticks(ms: Integer): longint;
begin
 result := (ms div 55);
 if result = 0 then
  result := 1;
end;

procedure TTerminalFunctions.SetProgressBar(pb: TProgressBar);
begin
  self.pb := pb;
end;

procedure TTerminalFunctions.ApdProtocollProtocolFinish(CP: TObject;
  ErrorCode: Integer);
begin

end;

procedure TTerminalFunctions.ApdProtocollProtocolStatus(CP: TObject;
  Options: Word);
begin
  if pb <> nil then begin
    pb.position := ApdProtocol.BytesTransferred;
    pb.Max := ApdProtocol.BytesTransferred+ApdProtocol.BytesRemaining;
    if options = apFirstCall then
      pb.Visible := true;
    if Options = apLastCall then
      pb.Visible := false;
  end;
end;

procedure TTerminalFunctions.RegisterDataCallBack(cb: TObject);
begin
  DataCallback := cb;
end;

procedure TTerminalFunctions.UnRegisterDataCallBack;
begin
  DataCallback := nil;
end;



function TTerminalFunctions.GetCOMPortNumber: integer;
begin
  result := ApdComPort.ComNumber;
end;

end.
